nick: Admin
date: 22.07.2003 23:26
subject: Willkommen im Gästebuch
text: Hallo Leute,<br><br>endlich ist das Gästebuch fertig, und wir hoffen auf nette Einträge.<br><br>Gruesse,<br><br>Die Admins
homepage: http://www.test.de/
email: [EMAIL=admins@no.org]admins@no.org[/EMAIL]

nick: bjkasdfbjkl
subject: dasfblasdjkfbasf
text: asdbnjfasdbjklfb <br>asdfnjklasdfn
date: 24.07.2003 20:18

nick: bjkasdfbjkl
subject: dasfblasdjkfbasf
text: asdbnjfasdbjklfb <br>asdfnjklasdfn
date: 24.07.2003 20:18

nick: bjkasdfbjkl
subject: dasfblasdjkfbasf
text: asdbnjfasdbjklfb <br>asdfnjklasdfn
date: 24.07.2003 20:19

nick: Martin Fabiani
email: <a href="mailto:martin@fabiani.net">martin@fabiani.net</a>
homepage: <a href="http://www.fabiani.net/" target="_blank">www.fabiani.net</a>
subject: blablabla
text: willkommen
date: 24.07.2003 20:20

#! /usr/bin/perl
use warnings;
use strict;
use CGI ();
use CGI::Carp qw(fatalsToBrowser);
use Fcntl ':flock';

use HTML::Template ();
use FindBin        ();

# die folgenden Module werden direkt in den Modulen geladen
# require URI::Find::Schemeless;
# require HTML::Entities;
# require Mail::RFC822::Address;

# ------------------------------------------------------------
# Fuer die Konfiguration Konstanten verwenden
# ------------------------------------------------------------

# wo liegt das Cascading Style Sheet fuer das Layout
use constant CSS_URL => '/styles/Default.css';

# wie viele Eintraege sollen pro Seite angezeigt werden?
use constant MAX_SHOW_ENTRIES => 10;

# Die Variable &#36FindBin::Bin enthaelt den absoluten Pfad des ausgefuehrten
# Scriptes. Ich verwende sie, um so einem absoluten Pfad zu erhalten, weil
# manche Webserver mit relativen Pfadangaben Schwierigkeiten haben, und da
# vom htdocs-Verzeichnis ausgehen. Und auf diese Weise vermeide ich diese
# potentiellen Probleme am einfachsten.

# wo werden die Gaestebucheintraege abgespeichert?
use constant GB_DATA_FILE => "&#36FindBin::Bin/data/guestbook.txt";

# wo liegen die Templates?
use constant TEMPLATE_DIR => "&#36FindBin::Bin/templates";

# wie sind die Dateinamen der Templates?
use constant TEMPLATE_FILES => {
    showguestbook => TEMPLATE_DIR . "/guestbook_show.templ",
    addguestbook  => TEMPLATE_DIR . "/guestbook_add.templ",
};

use constant GUESTBOOK_FIELDS => [qw(nick email homepage subject text date)];

# ------------------------------------------------------------
# Hauptprogramm
# ------------------------------------------------------------

# neues CGI-Objekt erzeugen
my &#36cgi = CGI::->new();

# aktion abfragen; wenn keine Vorhanden, dann guestbook verwenden
my &#36action = &#36cgi->param('action') || 'guestbook';

if ( &#36action eq 'guestbookadd' ) {
    &AddGuestbookEntry(&#36cgi);
}    # if
elsif ( &#36action eq 'guestbooksave' ) {
    &SaveNewGuestbookEntry(&#36cgi);
}    # elsif
else {    # Standardvorgehen: zeige das Gaestebuch an
    &ShowGuestbook(&#36cgi);
}    # else

# ------------------------------------------------------------
sub SaveNewGuestbookEntry {
    my (&#36cgi) = @_;
    my %data = ();
    foreach ( @{&GUESTBOOK_FIELDS} ) {
        &#36data{&#36_} = &#36cgi->param(&#36_) || '';
        &#36data{&#36_} =~ s/^\s*//;
        &#36data{&#36_} =~ s/\s*&#36//;
    }    # foreach

    unless ( &#36data{nick} ) {
        &#36data{message} .= "<br> Der Name muß angegeben werden";
    }    # unless
    unless ( &#36data{subject} ) {
        &#36data{message} .= "<br> Der Betreff muß angegeben werden";
    }    # unless
    unless ( &#36data{text} ) {
        &#36data{message} .= "<br> Der Text muß angegeben werden";
    }    # unless

    if ( &#36data{email} ) {    # Ueberpruefe die Email-Adresse
        require Mail::RFC822::Address;
        unless ( &Mail::RFC822::Address::valid( &#36data{email} ) ) {
            &#36data{message} .=
              "<br> Diese Email-Adresse ist fehlerhaft (nicht RFC822-Konform)";
        }               
     # else
    }    # if

    if ( &#36data{message} ) {
        &AddGuestbookEntry( &#36cgi, \%data );
    }    # if
    else {
        require URI::Find::Schemeless;
        require HTML::Entities;

        # neues URI::Find::Schemeless-Objekt erstellen und ihm als Callback
        # die Aktion mitgeben, die fuer jede gefundene URI ausgefuehrt werden
        # soll (fuer genauere Infos siehe [URL=http://www.fabiani.net/]http://www.fabiani.net/[/URL] -> Tips&Tricks
        # -> Urls in HTML-Links umwandeln
        my &#36finder = URI::Find::Schemeless->new(
            sub {
               
 my ( &#36uri, &#36originalUri ) = @_;

               
 return ( '<a href="'
               
       . &HTML::Entities::encode_entities("&#36uri")
               
       . '" target="_blank">'
               
       . &HTML::Entities::encode_entities(&#36originalUri)
               
       . '</a>' );

              }    # sub
        );

        # allgemeine Umwandlungen
        foreach ( @{&GUESTBOOK_FIELDS} ) {

            #           &#36data{&#36_} =~ s/</</g;    &#36data{&#36_} =~ s/>/>/g;
            #           &#36data{&#36_} =~ s/\&/&/g;
            #           &#36data{&#36_} =~ s/\"/"/g; &#36data{&#36_} =~ s/\'/'/g;

            # ersetze Sonderzeichen wie < > & ' " durch deren Codes
            &#36data{&#36_} = &CGI::escapeHTML( &#36data{&#36_} );

            # ersetze Zeilenumbruecke durch <br>
            &#36data{&#36_} =~ s/\r?
/<br>/g;

            # ersetze URIs durch HTML-Links
            &#36finder->find( \&#36data{&#36_} );

        }    # foreach

        # erzeuge email-link
        if ( &#36data{email} ) {
            &#36data{email} = qq~<a href="mailto:&#36data{email}">&#36data{email}</a>~;
        }    # if

        # ermittle Datum und Uhrzeit
        my @time = localtime(time);
        &#36time[4]++;
        &#36time[5] += 1900;
        &#36data{date} =
          sprintf( "%02i.%02i.%04i %02i\:%02i", @time[ 3 .. 5, 2, 1 ] );

        &SaveNewEntryToFile( &#36cgi, \%data )
          and &ShowGuestbook(&#36cgi);
    }
}    # SaveNewGuestbookEntry

# ------------------------------------------------------------
sub SaveNewEntryToFile {
    my ( &#36cgi, &#36data ) = @_;
    my &#36string = join ( "",
        map    { "&#36_: &#36data->{&#36_}
" }
          grep { &#36data->{&#36_} } @{&GUESTBOOK_FIELDS} );

    unless ( open( GB, ">>" . GB_DATA_FILE ) ) {
        &PrintErrorPage( &#36cgi, "Konnte Datei nicht oeffnen: &#36!" );
        exit;
    }    # unless
    else {
        flock( GB, LOCK_EX );
        print( GB "&#36string
" );
        close(GB);
    }    # else
    return 1;
}    # SaveNewEntryToFile

# ------------------------------------------------------------
sub AddGuestbookEntry {
    my ( &#36cgi, &#36data ) = @_;

    # gib den HTML-Header aus
    print &#36cgi->header( -type => 'text/html', -expires => '+5s' );

    # lese das Template ein:
    my &#36template = HTML::Template->new(
        filename     &nbs
p;    => TEMPLATE_FILES->{addguestbook},
        die_on_bad_params => 0,
    );
    &#36template->param(

        # Url des Scriptes und CSS-Stylesheet
        SELF_URL => &#36ENV{SCRIPT_NAME} || '',
        CSS_URL  => CSS_URL,

        # eine eventuelle Fehlermeldung
        MESSAGE => &#36data->{message} || '',

        # Die Daten im Falle eines Fehlers
        NICK     => &#36data->{nick}     || '',
        EMAIL    => &#36data->{email}    || '',
        HOMEPAGE => &#36data->{homepage} || '',
        SUBJECT  => &#36data->{subject}  || '',
        TEXT     => &#36data->{text}     || '',

    );

    print &#36template->output;
}    # AddGuestbookEntry

# ------------------------------------------------------------
sub ShowGuestbook {
    my (&#36cgi) = @_;

    # &#36startId ist der offset zur letzten Nachricht
    # also 0 entspricht der letzten Nachricht, 1 der vorletzten usw.
    my &#36startId = &#36cgi->param('id') || 0;
    &#36startId > 0 or &#36startId = 0;

    # gib den HTML-Header aus
    print &#36cgi->header( -type => 'text/html', -expires => '+5s' );

    # lese die Gaestebucheintraege von der Datei ein und gebe sie als
    # Arrayreferenz zurueck
    my ( &#36entries, &#36entriesCount, &#36x, &#36y ) = &ReadEntriesFromFile(&#36startId);

    # lese das Template ein:
    my &#36template = HTML::Template->new(
        filename     &nbs
p;    => TEMPLATE_FILES->{showguestbook},
        die_on_bad_params => 0,
    );

    &#36template->param(

        # Url des Scriptes und CSS-Stylesheet
        SELF_URL => &#36ENV{SCRIPT_NAME} || '',
        CSS_URL  => CSS_URL,

        # Daten
        ENTRIES_COUNT => &#36entriesCount + 1,
        GBDATA      
  => &#36entries,

        # fuer die Navigation
        SHOW_LINK_NEWER => &#36y < &#36entriesCount,
        SHOW_LINK_OLDER => &#36x > 0,
        OLDER_START_ID  => &#36entriesCount - &#36x + 1,
        NEWER_START_ID  => &#36entriesCount - &#36y - MAX_SHOW_ENTRIES,
    );

    print &#36template->output;

    #    print "&#36entriesCount: &#36x/&#36y:&#36startId
";
}    # ShowGuestbook

# ------------------------------------------------------------
sub ReadEntriesFromFile {
    my (&#36startId) = @_;

    my @entries = ();

    my &#36entryId = 1;
    unless ( open( GB, GB_DATA_FILE ) ) {
        &PrintErrorPage( &#36cgi, "Konnte Datei nicht oeffnen: &#36!" );
    }    # unless
    else {

        # blockweises Einlesen: eine "Zeile" enthaelt nun einen Block,
        # der durch eine Leerzeile vom naechsten getrennt ist
        local &#36/ = "

";

        while (<GB>) {

            # splitte den Block an den Zeilenumbruechen auf
            my @lines = split ( /
/, &#36_ );

            # wenn da keine Daten herauskommen, weiter mit dem naechsten Block
            next unless scalar @lines;

            my %entry = ();
            foreach my &#36line (@lines) {

               
 # trenne Namen: Wert
               
 my ( &#36key, &#36value ) = split ( /\s*:\s+/, &#36line, 2 );

               
 #             print "&#36entryId: &#36key: &#36value
";

               
 # ueberpruefe, ob fuer diesen Namen schon ein Wert vorhanden
               
 # ist, wenn ja, gib einen Fehler aus, wenn nein, fuegen den
               
 # Namen und den WErt zum Hash %entry hinzu
               
 if ( exists &#36entry{&#36key} ) {
               
     &PrintErrorPage( &#36cgi, "Format der Datei ungueltig" );
               
     exit 0;
               
 }    # if
               
 else {
               
     &#36entry{&#36key} = &#36value;
               
 }    # else

            }    # foreach

            # id des Eintrages hinzufuegen
            &#36entry{id} = &#36entryId;

            # Eintrag an den Anfang von @entries hinzufuegen
            unshift ( @entries, \%entry );

            # erhoehe EntryId
            &#36entryId++;

        }    # while

        close(GB);
    }    # else

    # finde heraus, welche Eintraege angezeigt werden sollen (von &#36x bis &#36y)
    my &#36count = &#36#entries;
    my &#36y     = &#36count - &#36startId;
    my &#36x     = ( &#36y > MAX_SHOW_ENTRIES ) ? &#36y - MAX_SHOW_ENTRIES + 1 : 0;

    # und werfe die anderen weg
    @entries = @entries[ &#36count - &#36y .. &#36count - &#36x ];

    # gib eine Arrayreferenz der Eintraege zurueck sowie deren Anzahl und
    # deren Grenzen
    return ( \@entries, &#36count, &#36x, &#36y );

}    # ReadEntriesFromFile

# ------------------------------------------------------------
sub PrintErrorPage {
    my ( &#36cgi, &#36errorMessage ) = @_;

    print "Fehler: &#36errorMessage
";

}    # PrintErrorPage

# ------------------------------------------------------------

show:
  SELF_URL
  CSS_URL

  SHOW_LINK_NEWER
  SHOW_LINK_OLDER
  OLDER_START_ID
  NEWER_START_ID

  ENTRIES_COUNT
  GBDATA
    ID (Automatisch)
    NICK (Pflichtfeld)
    EMAIL (optional)
    HOMEPAGE (optional)
    DATE (Automatisch)
    SUBJECT (Pflichtfeld)
    TEXT (Pflichtfeld)

body {
  background-image : url();
  background-color : C0C0C0;
  color            : Black;
}

h1 { 
   font-size: 20pt; 
   color: #6666FF; 
   font-style: bold;
}

td.text { background-color: #E0E0E0; }